home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfswdl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-26  |  3.4 KB  |  85 lines
  1. (*===========================================================================*)
  2. (* File subsystem -- list directory list                                     *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1990 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. PROCEDURE list_dir_list;
  13.  
  14.   VAR
  15.     found    : BOOLEAN;
  16.     this_fsb : fsb_ptr;
  17.  
  18.   BEGIN;
  19.  
  20.     found := FALSE;
  21.  
  22.     (*-----------------------------------------------------------------------*)
  23.     (* List all the directories                                              *)
  24.     (*-----------------------------------------------------------------------*)
  25.  
  26.     this_fsb := fsb_base;
  27.  
  28.     WHILE this_fsb <> NIL DO
  29.       WITH this_fsb^ DO
  30.         BEGIN;
  31.  
  32.           (*-----------------------------------------------------------------*)
  33.           (* If this guy can't download it, don't bother listing it          *)
  34.           (*-----------------------------------------------------------------*)
  35.  
  36.           IF active_tcb^.uid_data.user_class >= fsb_down THEN
  37.             BEGIN;
  38.  
  39.               (*-------------------------------------------------------------*)
  40.               (* If this is the first time through, put out the header       *)
  41.               (*-------------------------------------------------------------*)
  42.  
  43.               IF NOT found THEN
  44.                 BEGIN;
  45.                   send_message(message_direct_head);
  46.                   found := TRUE;
  47.                 END;
  48.  
  49.               (*-------------------------------------------------------------*)
  50.               (* Put out the name and the description (if one exists)        *)
  51.               (*-------------------------------------------------------------*)
  52.  
  53.               IF fsb_desc <> '' THEN
  54.                 send_tnc_data_str(LEFT(fsb_name, SIZEOF(fsb_name)) +
  55.                                                          '-- ' + fsb_desc + cr)
  56.               ELSE
  57.                 send_tnc_data_str(fsb_name + cr);
  58.  
  59.               (*-------------------------------------------------------------*)
  60.               (* Put out the aliases                                         *)
  61.               (*-------------------------------------------------------------*)
  62.  
  63.               IF fsb_alias <> '' THEN
  64.                 send_tnc_data_str(get_message(message_direct_alias) + ' ' +
  65.                                                                fsb_alias + cr);
  66.  
  67.             END;
  68.  
  69.           this_fsb := next_fsb;
  70.  
  71.         END; (*----- End of loop thru all the file control blocks -----------*)
  72.  
  73.     (*-----------------------------------------------------------------------*)
  74.     (* If nothing was ever found, tell user                                  *)
  75.     (*-----------------------------------------------------------------------*)
  76.  
  77.     IF NOT found THEN
  78.       BEGIN;
  79.         send_message(message_no_files_all);
  80.         active_tcb^.error_sw := TRUE;
  81.         EXIT;
  82.       END;
  83.  
  84.   END;
  85.